PsL Monthly 1993 December/PSL Monthly Shareware CD-ROM (December 1993).iso/prgmming/win/pascal/uglbedt.exe/UGLBEDIT.PAS

Pascal/Delphi Source File | 1993-01-10 | 5.7 KB | 201 lines

Unit UGlbEdit;
interface
uses WObjects,
     WinTypes,
     WinProcs,
     StdWnds;

const
SEGMENT=32760;
{ Creation window pointer for InitWndProc }
  CreationWindow: PWindowsObject = nil;

  psSegProp: array[0..3] of Char = 'OW1';
  psOfsProp: array[0..3] of Char = 'OW2';


type
  PGlbEdit = ^TGlbEdit;
  TGlbEdit = object(TEdit)
    wTextLength: word;
    constructor Init(AParent: PWindowsObject;
                AnId: Integer; ATitle: PChar; X,Y,W,H,
                ATextLen: Integer; Multiline : Boolean);
    procedure GetWindowClass(var AWndClass: TWndClass); virtual;
    procedure SetupWindow; virtual;
    function Create: boolean; virtual;
  end;

  PBigFileWindow = ^TBigFileWindow;
  TBigFileWindow = object(TFileWindow)
    constructor Init(AParent: PWindowsObject; ATitle, AFileName: PChar);
  end;

Implementation
{ Attach properties to provide a backup method retieving the object
  pointer from a HWindow }
procedure AttachProperties(HWindow: HWnd; Self: Pointer); assembler;
asm
    PUSH    HWindow
        PUSH    DS
        MOV    AX,OFFSET psSegProp
        PUSH    AX
        PUSH    Self.Word[2]
        CALL    SetProp
    PUSH    HWindow
        PUSH    DS
        MOV    AX,OFFSET psOfsProp
        PUSH    AX
        PUSH    Self.Word[0]
        CALL    SetProp
end;


{ Initialization window procedure }

function InitWndProc(HWindow: HWND; Message: Word; WParam: Word;
  LParam: Longint): Longint; export; assembler;
asm
    PUSH    HWindow
    MOV    AX,gwl_WndProc
    PUSH    AX
    LES    DI,CreationWindow
    LES    DI,ES:[DI].TWindowsObject.Instance
    PUSH    ES
    PUSH    DI
    CALL    SetWindowLong
        PUSH    HWindow
        LES    DI,CreationWindow
        PUSH    ES
        PUSH    DI
        CALL    AttachProperties
    PUSH    HWindow
    PUSH    Message
    PUSH    WParam
    PUSH    LParam.Word[2]
    PUSH    LParam.Word[0]
    MOV    AX,DS
    LES    DI,CreationWindow
    CALL    ES:[DI].TWindowsObject.Instance
end;

constructor TGlbEdit.Init(AParent: PWindowsObject;
                          AnId: Integer; ATitle: PChar; X,Y,W,H,
                          ATextLen: Integer; Multiline : Boolean);
begin
  wTextLength := ATextLen;
  TEdit.Init(AParent, AnId, ATitle, X,Y,W,H, ATextLen, MultiLine);
end {constructor};

{ Specifies registration attributes for the MS-Windows window class of the
  TWindow, allowing instances of TWindow to be registered.  Sets the fields
  of the passed TWndClass parameter to the default attributes appropriate
  for a TWindow. }

procedure TGlbEdit.GetWindowClass(var AWndClass: TWndClass);
begin
  AWndClass.cbClsExtra        := 0;
  AWndClass.cbWndExtra        := 0;
  AWndClass.hInstance        := HInstance;
  AWndClass.hIcon        := LoadIcon(0, idi_Application);
  AWndClass.hCursor        := LoadCursor(0, idc_Arrow);
  AWndClass.hbrBackground    := HBrush(color_Window + 1);
  AWndClass.lpszMenuName    := nil;
  AWndClass.lpszClassName    := GetClassName;
  AWndClass.style        := cs_HRedraw or cs_VRedraw;
  AWndClass.lpfnWndProc       := @InitWndProc;
end;

{    // This is done so that the limit text is done correctly.
    // If you subclass TGlbEdit be sure to call this function just
    // as TEdit::SetupWindow() is done below. }
procedure TGlbEdit.SetupWindow;
begin
  TEdit.SetupWindow;
  SendMessage(HWindow,EM_LIMITTEXT,wTextLength,0);
end {procedure};


function TGlbEdit.Create: Boolean;
var
  HParent: HWnd;
  TheMDIClient: PMDIClient;
  CreateStruct: TMDICreateStruct;
  heditds: THandle;
  hinst: THandle;
  lpPtr: pointer;
begin
  if Status = 0 then
  begin
    DisableAutoCreate;
    if Parent = nil then HParent := 0 else HParent := Parent^.HWindow;
    if not IsFlagSet(wb_FromResource) then
    begin
      if Register then
      begin
        CreationWindow := @Self;
        heditds := GlobalAlloc(
                            GMEM_DDESHARE or GMEM_MOVEABLE or GMEM_ZEROINIT,
                            SEGMENT
                            );
        {// if allocation fails then use the applications local heap}
        if (heditds = 0)
        then
          hinst := hInstance
        else begin
          lpPtr := GlobalLock(heditds);
          {// Initialize a local heap in the segment}
          LocalInit(HIWORD((LongInt(lpPtr))), 0,
                        WORD((GlobalSize(heditds) - 16)));
          UnlockSegment(HIWORD(LONGINT(lpPtr)));
          hinst := THandle(HIWORD(LONGINT(lpPtr)));
        end;
        if not IsFlagSet(wb_MDIChild) then
          with Attr do
            HWindow := CreateWindowEx(ExStyle, GetClassName, Title,
              Style, X, Y, W, H, HParent, Menu, Hinst, Param)
        else { MDI Child window }
    begin
      with CreateStruct do
      begin
        szClass := GetClassName;
        szTitle := Attr.Title;
        hOwner := Hinst;
        x := Attr.X; y := Attr.Y; cx := Attr.W; cy := Attr.H;
        style := Attr.Style;
      end;
      TheMDIClient := Parent^.GetClient;
      if TheMDIClient <> nil then
        HWindow := HWnd(SendMessage(TheMDIClient^.HWindow, wm_MDICreate, 0,
          Longint(@CreateStruct)));
    end; { MDI Child window }
      end;
    end
    else { Windows already created window }
      HWindow := GetDlgItem(HParent, Attr.ID);
    if HWindow = 0 then
      Status := em_InvalidWindow
    else
      if GetObjectPtr(HWindow) = nil then
      begin
        AttachProperties(HWindow, @Self);
    DefaultProc := TFarProc(SetWindowLong(HWindow, gwl_WndProc,
      LongInt(Instance)));
    SetupWindow;
      end;
  end;
  Create := Status = 0;
end;

constructor TBigFileWindow.Init(AParent: PWindowsObject;
                                ATitle, AFileName: PChar);
begin
  TFileWindow.Init(AParent, ATitle, AFileName);
  Dispose(Editor, Done);
  Editor := New(PGlbEdit, Init(@Self, 200, nil, 0, 0, 0, 0, SEGMENT  , True));
  with Editor^.Attr do
    Style := Style or es_NoHideSel;
end {constructor};

End.